Source: https://github.com/markziemann/cryptoblog/blob/main/ma_trading.Rmd

This report is distributed for FREE under the MIT licence, but if you find it useful, consider a small tip.

XMR:4BGrdeAF5qyJQXjzWF4W5uCZF7WuwJU16BfPtgg1WJMnf33jZMtLvoF1jRtZBGpLtz5BQZaLYiBFJJC488anty64FB7SASD

Intro

Keltner Channels are volatility-based envelopes set above and below a moving average. This indicator is similar to Bollinger Bands, but Keltner Channels use the Average True Range (ATR) to set channel distance. Keltner Channels are a trend following indicator, and can also be used to identify overbought and oversold levels when there is no trend.

Chester Keltner is credited with the original version of Keltner Channels in his 1960 book. Linda Bradford Raschke introduced the newer version of Keltner Channels in the 1980s.

This page is designed to be updated daily - today’s date is shown below.

suppressPackageStartupMessages({
  library("jsonlite")
  library("tidyverse")
  library("runner")
  library("quantmod")
  library("TTR")
  library("vioplot")
  library("kableExtra")
})

Sys.Date()
## [1] "2022-07-02"

Reminder: this is not financial advice.

Keltner channel indicator

Thanks to Nick Procyk for providing the KC indicator code to TTR.

KC <-
function (HLC, n = 20, maType, atr = 2, ...)
{
    atrHLC <- HLC
    HLC <- try.xts(HLC, error = as.matrix)
    if (NCOL(HLC) == 3) {
        if (is.xts(HLC)) {
            xa <- xcoredata(HLC)
            HLC <- xts(apply(HLC, 1, mean), index(HLC))
            xcoredata(HLC) <- xa
        }
        else {
            HLC <- apply(HLC, 1, mean)
        }
    }
    else if (NCOL(HLC) != 1) {
        stop("Price series must be either High-Low-Close, or Close/univariate.")
    }
    maArgs <- list(n = n, ...)
    if (missing(maType)) {
        maType <- "EMA"
    }
    mavg <- do.call(maType, c(list(HLC), maArgs))
    avgtruerange <- ATR(atrHLC, n = n)

    up <- mavg + atr * avgtruerange[,2]
    dn <- mavg - atr * avgtruerange[,2]

    res <- cbind(dn, mavg, up)
    colnames(res) <- c("dn", "mavg", "up")
    reclass(res, HLC)
}

#KChannels(HLC, n = 20, maType, atr = 2, ...)

HLC Object that is coercible to xts or matrix and contains High-Low-Close prices. If only a univariate series is given, it will be used. See details.

n Number of periods for moving average.

maType A function or a string naming the function to be called.

atr The number of average true range distances to apply.

… Other arguments to be passed to the maType function.

Weekly KC for BTC

mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=BTC&convert=USD&interval=weekly&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="btcdat.txt")

dat <- fromJSON("btcdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
  price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)

10 week KC.

kc <- KC(HLC(price), n = 10, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

20 week KC.

kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

Daily KC for BTC

Obtaining BTC historical data (daily) from CoinMarketCap.com from June 2013 to present.

mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=BTC&convert=USD&interval=daily&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="btcdat.txt")

dat <- fromJSON("btcdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high, 
  price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

kc <- KC(HLC(price), n = 43, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=43d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

kc <- KC(HLC(price), n = 72, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=72d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

KC BTC daily recent action

kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

Weekly KC for ETH

mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=ETH&convert=USD&interval=weekly&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="ethdat.txt")

dat <- fromJSON("ethdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
  price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)

10 week KC.

kc <- KC(HLC(price), n = 10, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

20 week KC.

kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

Daily KC for ETH

Obtaining ETH historical data (daily) from CoinMarketCap.com from 2015 to present.

mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=ETH&convert=USD&interval=daily&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="ethdat.txt")

dat <- fromJSON("ethdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
  price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

kc <- KC(HLC(price), n = 43, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=43d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

kc <- KC(HLC(price), n = 72, maType=SMA, atr = 2)

plot(price$close~as.Date(price$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=72d")
grid()
lines(as.Date(price$date) ,  kc[,"dn"] ,col="red")
lines(as.Date(price$date) ,  kc[,"mavg"] , col="red")
lines(as.Date(price$date) ,  kc[,"up"] , col="red")

KC ETH daily recent action

kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)

price2 <- tail(price,200)
kc2 <- tail(kc,200)

plot(price2$close~as.Date(price2$date),type="l",log="y",
  xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price2$date) ,  kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) ,  kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) ,  kc2[,"up"] , col="red")

Session information

For reproducibility

sessionInfo()
## R version 4.1.2 (2021-11-01)
## Platform: aarch64-unknown-linux-gnu (64-bit)
## Running under: Ubuntu 22.04 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/aarch64-linux-gnu/blas/libblas.so.3.10.0
## LAPACK: /usr/lib/aarch64-linux-gnu/lapack/liblapack.so.3.10.0
## 
## locale:
##  [1] LC_CTYPE=en_AU.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_AU.UTF-8        LC_COLLATE=en_AU.UTF-8    
##  [5] LC_MONETARY=en_AU.UTF-8    LC_MESSAGES=en_AU.UTF-8   
##  [7] LC_PAPER=en_AU.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_AU.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] kableExtra_1.3.4 vioplot_0.3.7    sm_2.2-5.7       quantmod_0.4.20 
##  [5] TTR_0.24.3       xts_0.12.1       zoo_1.8-10       runner_0.4.1    
##  [9] forcats_0.5.1    stringr_1.4.0    dplyr_1.0.9      purrr_0.3.4     
## [13] readr_2.1.2      tidyr_1.2.0      tibble_3.1.7     ggplot2_3.3.6   
## [17] tidyverse_1.3.1  jsonlite_1.8.0  
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.8.3      svglite_2.1.0     lubridate_1.8.0   lattice_0.20-45  
##  [5] assertthat_0.2.1  digest_0.6.29     utf8_1.2.2        R6_2.5.1         
##  [9] cellranger_1.1.0  backports_1.4.1   reprex_2.0.1      evaluate_0.15    
## [13] highr_0.9         httr_1.4.3        pillar_1.7.0      rlang_1.0.2      
## [17] curl_4.3.2        readxl_1.4.0      rstudioapi_0.13   jquerylib_0.1.4  
## [21] rmarkdown_2.14    webshot_0.5.3     munsell_0.5.0     broom_0.8.0      
## [25] compiler_4.1.2    modelr_0.1.8      xfun_0.30         systemfonts_1.0.4
## [29] pkgconfig_2.0.3   htmltools_0.5.2   tidyselect_1.1.2  viridisLite_0.4.0
## [33] fansi_1.0.3       crayon_1.5.1      tzdb_0.3.0        dbplyr_2.1.1     
## [37] withr_2.5.0       grid_4.1.2        gtable_0.3.0      lifecycle_1.0.1  
## [41] DBI_1.1.2         magrittr_2.0.3    scales_1.2.0      cli_3.3.0        
## [45] stringi_1.7.6     fs_1.5.2          xml2_1.3.3        bslib_0.3.1      
## [49] ellipsis_0.3.2    generics_0.1.2    vctrs_0.4.1       tools_4.1.2      
## [53] glue_1.6.2        hms_1.1.1         parallel_4.1.2    fastmap_1.1.0    
## [57] yaml_2.3.5        colorspace_2.0-3  rvest_1.0.2       knitr_1.39       
## [61] haven_2.5.0       sass_0.4.1